perm filename MULTL.WRK[QLA,LSP] blob sn#766726 filedate 1984-08-23 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00021 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	(load "multl.5")
C00005 00003	(make-multi-processor 3)
C00006 00004	(make-multi-processor 3)
C00008 00005	(load "multl.6")
C00009 00006	(load "nmultl.22")
C00011 00007	(*rset (nouuo t))
C00014 00008	(make-multi-processor 8)
C00015 00009
C00016 00010	(make-multi-processor 10)
C00017 00011	(load "multl.9")(fasload multl)(*rset (nouuo t))
C00019 00012	(m-defun add-up3 (l)
C00020 00013	(m-defun t1 ()
C00021 00014	(load "multl.9")(fasload multl)(*rset (nouuo t))
C00022 00015	(load "multl.11")
C00024 00016	(load "multl.11")
C00025 00017	(load "multl.11")
C00026 00018	(load "multl.16")
C00028 00019	(load "multl.19")
C00029 00020	(let ((f (qlambda t () (do ((i 40 (1- i)))
C00030 00021	tn iguana
C00031 ENDMK
CāŠ—;
(load "multl.5")

(fasload multl)
(*rset (nouuo ()))

(step make-multi-processor)

(make-multi-processor 1)
(eval-form '(print (quote a)))
(multi-process *machine*)

(eval-form '(print (quote 7)))
(step multi-process)

(setq a (make-queue))
(add-queue 'baz a)
(get-queue a)

*machine*


(make-multi-processor 2)
(eval-form '((lambda (f y) (print (f y)))
	     (lambda (x) (times x 2)) 7))
(eval-form '(cond (() (print 7)) (t (print 8))))
(eval-forms '(print (plus (times 5 7) 4))
	    '(print (times (plus 1 2) 3)))
(eval-form '(print (times (plus 1 2) (plus 3 4))))
(eval-form '(print (plus 1 2))))
(eval-form '(print (fact 3)))
(eval-form '(print (add2 7)))
(run *machine*)

(multi-process *machine*)
*arg-stack*
*pc-stack*
*evarg-stack*
*environment*


(m-defun fact (n)
	 (cond ((zerop n) 1)
	       (t (times n (fact (1- n))))))

(defmacro add2 (x)
	  `(plus ,x 2))

(make-multi-processor 3)

(eval-form '((qlambda t (x y)(print (times x y))) 2 3))
(eval-form '((qlambda t (x y)(print (times x y)))  (plus 1 2)(plus 2 3))) 
(eval-form '((qlambda () (x y)(print (times x y)))  (plus 1 2)(plus 2 3))) 
(eval-form '((qlambda () (x y)(print (times x y))) 2 3))

(run *machine*)

*pc-stack*
*arg-stack*

(eval-form '(print ((closure (lambda () x) ((x . 9))))))

(baktrace)

(meval '((qlambda t (x y)(times x y))  (plus 1 2)(plus 2 3))) 
(make-multi-processor 3)

(meval '((lambda (f x)
		 (f x))
	 (qlambda t (y) (print (times y y)))
	 7)))))

(make-multi-processor 3)
(eval-form '(print
(startup 16)

	     (catch 'baz
		    ((lambda (f a b)
			     (f a b))
		     (qlambda t (y z) (throw 'baz -3))
		     9 7))

(run *machine*)

(run *machine*)

(debug)
d
*PC-STACK*
*ARG-STACK*
(print-jobs)

(length *all-jobs*)
(m-gc)

(step m-gc)

(job-list *self*)
(setq prinlevel 3)

(make-multi-processor 1)
(eval-form '(print

	     (do ((i 5 (1- i))
		  (j -5 (1+ j)))
		 ((= i 0) (print 'foo))
		 (cond ((= i 3) (return 'baz))
		       (t (print (plus i j)))))))

(run *machine*)

(make-multi-processor 1)
(eval-form '(print
	     (do ((i 5 (1- i))
		  (j -5 (1+ j)))
		 ((= i 0) (print 'foo))
		 (print (list i j)))))
(run *machine*)

(make-multi-processor 1)
(eval-form '(print

	     (catch 'baz
		    (plus 3 (throw 'baz 7)))))

(run *machine*)

(load "multl.6")
(make-multi-processor 3)

(meval
 '((lambda (f x)
	   (f x)
	   (print x))
   (qlambda t (y) (do () (()) (print 'heh)))
   7)))))

(meval
 '((lambda (x)
	   (funcall (qlambda t (y) (do () (()) (print y))) x)
	   (print (times x x)))
   7))

(print-jobs)

(m-defun baz (n)
	 (cond ((= n 0)(plus n n))
	       (t ((qlambda t (x)
			    (plus x x))
		   (baz (1- n)))))))

(make-multi-processor 1)
(meval '(baz 1))
(print-jobs)
*valuep*

*pc-stack*
*arg-stack*
(load "nmultl.22")

(m-defun fib (n)
	 (cond ((zerop n) 1)
	       ((= n 1) 1)
	       (t
		(qlet t
		      ((x (fib (1- n) ))
		       (y (fib (- n 2) )))
		      (plus x y)))))

(m-defun fib (n)
	 (cond ((zerop n) 1)
	       ((= n 1) 1)
	       (t
		((lambda (x y)
		      (plus x y))
		 (fib (1- n) )
		 (progn (qbreak) (fib (- n 2) ))))))

(m-defun fib (n)
	 (cond ((zerop n) 1)
	       ((= n 1) 1)
	       (t
		((qlambda t (x y)
			  (plus x y))
		 (fib (1- n) )
		 (fib (- n 2) )))))))

(make-multi-processor 10)
(setq cutoff 3)
(setq *process-creation-time* 0)
(meval '(fib 5))
8 
Number of Processors:	10
Processes Created:	1
Wait Cycles:		0
Active Cycles:		492
Multiprocessor Steps:	493
NIL 

(qlet t ((x 1)(y 2))(+ x y))

((qlambda t (x y) (+ x 2)) 1 2)

(m-defun foo (x)(+ x 2))
(fib 5)
(*rset (nouuo t))
(load "multl.6")

(make-multi-processor 5)
(m-defun baz (g n)
	 (g n))

(meval '(let ((f (qlambda t (x)
			  (print x)
			  (times x x))))
	     (print f)
	     ((lambda (a)
		      (plus a a))
	      (baz f 5))))

(meval '((lambda (f)
		 (print f)
		 ((lambda (a)
			  (plus a a))
		  (baz f 5)))
	 (qlambda t (x)
		  (print x)
		  (times x x))))

(meval '(let ((f (qlambda t (x)
			  (print x)
			  (times x x))))
	     ((lambda (a b)
		      (plus a b))
	      (baz f 5)
	      (baz f 6))))

(meval '(let ((f (qlambda t (x)
			  (print x)
			  (times x x))))
	     ((qlambda t (a b)
		      (plus a b))
	      (baz f 5)
	      (baz f 6))))

(setq prinlevel 3 prinlength 6)

(print-jobs)

(arg-stack job)
(pc-stack job)
(EVALING (PRINT (LET ((F (QLAMBDA T (X) (PRINT X) (TIMES X X)))) ((LAMBDA 
(A B) (PLUS A B)) (BAZ F 5) (BAZ F 6))))) 
(EVALING (LET ((F (QLAMBDA T (X) (PRINT X) (TIMES X X)))) ((LAMBDA (A B) 
(PLUS A B)) (BAZ F 5) (BAZ F 6)))) 
(EVALING (LET! ((F (QLAMBDA T (X) (PRINT X) (TIMES X X)))) ((LAMBDA (A 
B) (PLUS A B)) (BAZ F 5) (BAZ F 6)))) 
(EVALING ((LAMBDA (F) ((LAMBDA (A B) (PLUS A B)) (BAZ F 5) (BAZ F 6))) 
(QLAMBDA T (X) (PRINT X) (TIMES X X)))) 
(EVALING (QLAMBDA T (X) (PRINT X) (TIMES X X))) 
(EVALING ((LAMBDA (A B) (PLUS A B)) (BAZ F 5) (BAZ F 6))) 
(EVALING (BAZ F 5)) 
(EVALING F) 
(EVALING 5) 
(EVALING (G N)) 
(EVALING N) 
(EVALING (PRINT X)) 
(EVALING X) 
5 
(EVALING (TIMES X X)) 
(EVALING X) 
(EVALING X) 
(EVALING (BAZ F 6)) 
(EVALING F) 
(EVALING 6) 
(EVALING (G N)) 
(EVALING N) 
Number of Processors:	5
Processes Created:	2
Wait Cycles:		14
Active Cycles:		47
Multiprocessor Steps:	47
NIL 
(make-multi-processor 8)
(setq foo 7)
(setq *global-contention* 10)

(meval '((qlambda t (x y)
		  (setq foo x)
		  (plus x y))
	 (plus foo foo)
	 (plus foo foo)))

*environment*

(setq *global-read-time* 5)
(setq *global-write-time* 5)

(load "multl.6")

(setq cutoff 2)
(make-multi-processor 2)
(meval '(fib 2 0))

(setq *process-creation-time* 0)
(setq *global-read-time* 340)
(setq *global-write-time* 00)
    (make-multi-processor 5)
    (setq cutoff 3)
    (print `((fib 10) cutoff = ,cutoff)) 
    (meval `(fib 10 0)))))

*global-read-time*
n
*pc-stack*
*arg-stack*
(make-multi-processor 10)

(meval '((lambda (f)
		 ((lambda (y)
			  (f y))
		  2))
	 (lambda (y) (print y)))))

*environment*
val
fun

(m-defun foo (x)
	 (baz x))

(defmacro baz (x)
	  `(bar ,x))

(defmacro bar (x) 
	  `(plus ,x ,x))

	 (let ((y (times x x)))
	      (plus y y)))

(meval '(foo 2))
(print-jobs)

(make-multi-processor 10)

(startup 10)
(defmacro b (x) `(bat ,x ,x))
(plist 'defmacro)
(funcall (get 'defmacro 'macro)
	 '(defmacro b (x) `(bat ,x ,x)))
(load "multl.9")(fasload multl)(*rset (nouuo t))

(startup 16)

(m-defun add-up (x)
	 (cond ((null x) 0)
	       ((numberp x) x)
	       (t (qlet 'eager ((m
				  (add-up (car x)))
				 (n
				  (add-up (cdr x))))
			(+ m n)))))

(m-defun add-up2 (x)
	 (cond ((null x) 0)
	       ((numberp x) x)
	       (t ((qlambda t  (m n)
			    (+ m n))
		   (add-up2 (car x))
		   (add-up2 (cdr x))))))

(setq l '(1 2 3 4))
*pc-stack* *arg-stack*
*catch-thread*
(add-up l)
10 
Number of Processors:	16
Processes Created:	9
Global Read Conflicts:	0
Global Write Conflicts:	0
Wait Cycles:		358
Active Cycles:		323
Multiprocessor Steps:	200
=> 
(add-up2 l)
10 
Number of Processors:	16
Processes Created:	9
Global Read Conflicts:	0
Global Write Conflicts:	0
Wait Cycles:		348
Active Cycles:		295
Multiprocessor Steps:	186
=> 

(m-defun test (x)
	 (print (length *pc-stack*))
	 (test))
(m-defun add-up3 (l)
	 ((lambda (adder)
		  (setq *sum* 0)
 		  (qcatch 'end
			  (progn (funcall (qlambda t () (add-all3 adder l)))
				 t)) 
		  *sum*)
	  (qlambda t (x)
		   (setq *sum* (plus *sum* x)))))
(m-defun add-all3 (f x)
	 (cond ((null x) t)
	       ((numberp x)
		(print x)
		(f x))
	       (t (funcall (qlambda t () (add-all3 f (car x))))
		  (add-all3 f (cdr x)))))

(setq l '(((((1 2)))) (((3 4))) (((((((5)))))))) *sum* 0)

(add-up3 '(1 2 3))

(load "multl.9")

(startup 16)

*environment*
*valuep*
fun
new-valuep
*pc-stack*
arm
(setq prinlevel 3)
(m-defun t1 ()
	 (qcatch 'the-end
		 (progn
		  (qcatch 'end
			  (funcall (qlambda t ()
					    (do ((i 10 (1- i)))
						((zerop i)
						 (throw 'end 0))))))
		  (qcatch 'end (funcall (qlambda t ()
						 (do ((i 10 (1- i)))
						     ((zerop i)
						      (throw 'end 0))))))
		  (funcall (qlambda t ()
				    (do ((i 20 (1- i)))
					((zerop i)
					 (throw 'the-end 1)))))
		  t)))

(t1)
(load "multl.9")(fasload multl)(*rset (nouuo t))

(qcatch 'foo
	(do ((a '(1 2 3) (cdr a)))
	    ((null a) t)
	    (funcall
	     (qlambda t ()
		      (do ()(())
			  (print (car a)))))))

(print-jobs)
(startup 16)

(m-defun foo (x)
	 (labels ((foo (qlambda t (x)
			       (cond ((zerop x) 1)
				     (t (* x (foo (1- x))))))))
		 (foo x)))

(foo 3)

(setq *l* '(1 . 2))

(let ((h (qlambda t (q)(q *l*)))
      (setcar
       (lambda (x)
	       (h (lambda (l)
			  (rplaca l x))))))
     (setcar 8))

*l*
(load "multl.11")

(startup 16)

(let ((q 9))
     (let ((f (qlambda 'lazy ()
		       (print 'hi)
		       q)))
	  (do ((i 2 (1- i)))
	      ((zerop i) 'done) (print i))
	  (f)
	  (f)))

(setq prinlevel 4)
*arg-stack*
*pc-stack*
cells
2 
1 
HI 
HI 
9 
Number of Processors:	16
Processes Created:	1
Processes Scheduled:	2
Global Read Conflicts:	0
Global Write Conflicts:	0
Wait Cycles:		11
Active Cycles:		100
Multiprocessor Steps:	96
=> 
HI 
2 
1 
HI 
9 
Number of Processors:	16
Processes Created:	1
Processes Scheduled:	3
Global Read Conflicts:	0
Global Write Conflicts:	0
Wait Cycles:		59
Active Cycles:		104
Multiprocessor Steps:	95
=> 

(let ((f (qlambda t () (do () (()) (print 'a)))))
     (let ((g (qlambda t () (do () (())
				(suspend-process f)
				(do ((i 5 (1- i)))
				    ((zerop i)(resume-process f))
				    (print `(,i b)))))))
	  (f)(g)))

(labels ((f (qlambda t (x)
		     (print `(f ,x))
		     (g (1+ x))))
	 (g (qlambda t (x)
		     (print `(g ,x))
		     (f (1- x)))))
	(f 0))
		     

(labels ((f (lambda (x)
		    (print `(f ,x))
		    (g (1+ x))))
	 (g (lambda (x)
		    (print `(g ,x))
		    (f (1- x)))))
	(f 0))
		     
(load "multl.11")

(m-defun mcons (a b)
	 (lambda (mess)
		 (cond ((eq mess 'car) a)
		       ((eq mess 'cdr) b)
		       ((eq mess 'rplaca)
			(lambda (x)
				(setq a x)))
		       ((eq mess 'rplacd)
			(lambda (x)
				(setq b x))))))

(setq *silence* t)

(setq q (mcons 'a 'b))

(funcall (q 'rplaca) 1)
(funcall (q 'rplacd) 2)
(q 'car)
(q 'cdr)

(setq a 9)
(meval '(mcons 'a 'b))
*arg-stack*
(load "multl.11")

(let ((i 2))
     ((qlambda t (x y)
	       (+ x y))
      (do ((j 5 (1- j)))
	  ((zerop j) i)
	  i i i i
	  (print i))
      (do ((j 5 (1- j)))
	  ((zerop j) i)
	  i i i i i
	  (print i))))

(setq *read-time* 1 *write-time* 1 *variable-conflict-window* 5)

*arg-stack*
*pc-stack*

2 
2 
2 
2 
4 
Number of Processors:	16
Processes Created:	2
Processes Scheduled:	3
Read Conflicts:		10
Write Conflicts:	0
Wait Cycles:		188
Active Cycles:		389
Multiprocessor Steps:	216
=> 
(load "multl.16")
(fasload multl)
(*rset (nouuo t))
(setq *silence* t)
(startup 16)
(setq prinlevel 3 prinlength 4)

(qcatch 'baz
       (catch 'tag 
	      (do ((i 1 (1+ i)))
		  ((= i 4) (print 'Die!) 7)
		  (funcall (qlambda t ()
				    (unwind-protect
				     (unwind-protect
				      (do () (()))
				      (progn
				       (print `(killed ,i))
				       (throw 'baz 9)))
				     (print `(dying ,i))))))))

(do ((i 5 (1- i))) ((zerop i)()))

(caseq 'b
       (b (print 'b))
       (c (print 'c))
       ((a d) (print '(a or d)))
       (t (print 'dunno)))


(DEFMACRO MAP-AND (FUN LIST)
 `(QCATCH 'MAP-AND
   (DO ((L ,LIST (CDR L)))
       ((NULL L) T)
       (SPAWN
	(COND ((NOT (,FUN (CAR L)))
	       (THROW 'MAP-AND ())))))))

(DEFMACRO SPAWN (FORM)
	  `(FUNCALL (QLAMBDA T () ,FORM)))

(map-and oddp '(1 3 5 7 9 11 13 15 17 18 19 21))

(load "multl.19")
(m-qdefun foo t (n)(print n))

(qcatch 'foo (foo 3))
(setq prinlevel 3)
*pc-stack*
*arg-stack*
(debug)
(debug t)

(startup 16)

((lambda (f)
	 (* 2 (f 1 2)))
 (qlambda t (x y)(plus x y)))

(defun mult-eval (form)
       (push form *arg-stack*)
       (push 'm-eval-1 *pc-stack*)
       t)

(m-eval '(print 'heh))

(let ((f (qlambda t () (do ((i 10 (1- i)))
			   ((zerop i) (print 'here))))))
     (progn
      (no-wait (f))
      (print 'there)))
(let ((f (qlambda t () (do ((i 40 (1- i)))
			   ((zerop i)
			    (print 'heh))))))
     (funcall f)
     (print 'baz))

(let ((lock (create-lock)))
     (get-lock lock)
     (if-lockp lock (print 'got-it)
	       (print 'nope)))
tn iguana